home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / flex / aflexx-a / aflex.lha / aflex / src / ecsB.a < prev    next >
Encoding:
Text File  |  1991-05-16  |  6.3 KB  |  202 lines
  1. -- Copyright (c) 1990 Regents of the University of California.
  2. -- All rights reserved.
  3. --
  4. -- This software was developed by John Self of the Arcadia project
  5. -- at the University of California, Irvine.
  6. --
  7. -- Redistribution and use in source and binary forms are permitted
  8. -- provided that the above copyright notice and this paragraph are
  9. -- duplicated in all such forms and that any documentation,
  10. -- advertising materials, and other materials related to such
  11. -- distribution and use acknowledge that the software was developed
  12. -- by the University of California, Irvine.  The name of the
  13. -- University may not be used to endorse or promote products derived
  14. -- from this software without specific prior written permission.
  15. -- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
  16. -- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
  17. -- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  18.  
  19. -- TITLE equivalence class
  20. -- AUTHOR: John Self (UCI)
  21. -- DESCRIPTION finds equivalence classes so DFA will be smaller
  22. -- $Header: /co/ua/self/arcadia/aflex/ada/src/RCS/ecsB.a,v 1.7 90/01/12 15:19:54 self Exp Locker: self $ 
  23.  
  24. with MISC_DEFS; 
  25. with MISC; use MISC_DEFS; 
  26. package body ECS is 
  27.  
  28. -- ccl2ecl - convert character classes to set of equivalence classes
  29.  
  30.   procedure CCL2ECL is 
  31.     use MISC_DEFS; 
  32.     ICH, NEWLEN, CCLP, CCLMEC : INTEGER; 
  33.   begin
  34.     for I in 1 .. LASTCCL loop
  35.  
  36.       -- we loop through each character class, and for each character
  37.       -- in the class, add the character's equivalence class to the
  38.       -- new "character" class we are creating.  Thus when we are all
  39.       -- done, character classes will really consist of collections
  40.       -- of equivalence classes
  41.       NEWLEN := 0; 
  42.       CCLP := CCLMAP(I); 
  43.  
  44.       for CCLS in 0 .. CCLLEN(I) - 1 loop
  45.         ICH := CHARACTER'POS(CCLTBL(CCLP + CCLS)); 
  46.         CCLMEC := ECGROUP(ICH); 
  47.         if (CCLMEC > 0) then 
  48.           CCLTBL(CCLP + NEWLEN) := CHARACTER'VAL(CCLMEC); 
  49.           NEWLEN := NEWLEN + 1; 
  50.         end if; 
  51.       end loop; 
  52.  
  53.       CCLLEN(I) := NEWLEN; 
  54.     end loop; 
  55.   end CCL2ECL; 
  56.  
  57.  
  58.   -- cre8ecs - associate equivalence class numbers with class members
  59.   --  fwd is the forward linked-list of equivalence class members.  bck
  60.   --  is the backward linked-list, and num is the number of class members.
  61.   --  Returned is the number of classes.
  62.  
  63.   procedure CRE8ECS(FWD, BCK : in out C_SIZE_ARRAY; 
  64.                     NUM      : in INTEGER; 
  65.                     RESULT   : out INTEGER) is 
  66.     J, NUMCL : INTEGER; 
  67.   begin
  68.     NUMCL := 0; 
  69.  
  70.     -- create equivalence class numbers.  From now on, abs( bck(x) )
  71.     -- is the equivalence class number for object x.  If bck(x)
  72.     -- is positive, then x is the representative of its equivalence
  73.     -- class.
  74.     for I in 1 .. NUM loop
  75.       if (BCK(I) = NIL) then 
  76.         NUMCL := NUMCL + 1; 
  77.         BCK(I) := NUMCL; 
  78.         J := FWD(I); 
  79.         while (J /= NIL) loop
  80.           BCK(J) :=  -NUMCL; 
  81.           J := FWD(J); 
  82.         end loop; 
  83.       end if; 
  84.     end loop; 
  85.     RESULT := NUMCL; 
  86.     return; 
  87.   end CRE8ECS; 
  88.  
  89.  
  90.   -- mkeccl - update equivalence classes based on character class xtions
  91.   -- where ccls contains the elements of the character class, lenccl is the
  92.   -- number of elements in the ccl, fwd is the forward link-list of equivalent
  93.   -- characters, bck is the backward link-list, and llsiz size of the link-list
  94.  
  95.   procedure MKECCL(CCLS     : in out CHAR_ARRAY; 
  96.                    LENCCL   : in INTEGER; 
  97.                    FWD, BCK : in out UNBOUNDED_INT_ARRAY; 
  98.                    LLSIZ    : in INTEGER) is 
  99.     use MISC_DEFS, MISC; 
  100.     CCLP, OLDEC, NEWEC, CCLM, I, J : INTEGER; 
  101.     PROC_ARRAY                     : BOOLEAN_PTR; 
  102.   begin
  103.  
  104.     -- note that it doesn't matter whether or not the character class is
  105.     -- negated.  The same results will be obtained in either case.
  106.     CCLP := CCLS'FIRST; 
  107.  
  108.     -- this array tells whether or not a character class has been processed.
  109.     PROC_ARRAY := new BOOLEAN_ARRAY(CCLS'FIRST .. CCLS'LAST); 
  110.     for CCL_INDEX in CCLS'FIRST .. CCLS'LAST loop
  111.       PROC_ARRAY(CCL_INDEX) := FALSE; 
  112.     end loop; 
  113.  
  114.     while (CCLP < LENCCL + CCLS'FIRST) loop
  115.       CCLM := CHARACTER'POS(CCLS(CCLP)); 
  116.       OLDEC := BCK(CCLM); 
  117.       NEWEC := CCLM; 
  118.  
  119.       J := CCLP + 1; 
  120.  
  121.       I := FWD(CCLM); 
  122.       while ((I /= NIL) and (I <= LLSIZ)) loop
  123.  
  124.         -- look for the symbol in the character class
  125.         while ((J < LENCCL + CCLS'FIRST) and ((CCLS(J) <= CHARACTER'VAL(I)) or 
  126.           PROC_ARRAY(J))) loop
  127.           if (CCLS(J) = CHARACTER'VAL(I)) then 
  128.  
  129.             -- we found an old companion of cclm in the ccl.
  130.             -- link it into the new equivalence class and flag it as
  131.             -- having been processed
  132.             BCK(I) := NEWEC; 
  133.             FWD(NEWEC) := I; 
  134.             NEWEC := I; 
  135.             PROC_ARRAY(J) := TRUE; 
  136.  
  137.             -- set flag so we don't reprocess
  138.  
  139.             -- get next equivalence class member
  140.             -- continue 2
  141.             goto NEXT_PT; 
  142.           end if; 
  143.           J := J + 1; 
  144.         end loop; 
  145.  
  146.         -- symbol isn't in character class.  Put it in the old equivalence
  147.         -- class
  148.         BCK(I) := OLDEC; 
  149.  
  150.         if (OLDEC /= NIL) then 
  151.           FWD(OLDEC) := I; 
  152.         end if; 
  153.  
  154.         OLDEC := I; 
  155.         <<NEXT_PT>> I := FWD(I); 
  156.       end loop; 
  157.  
  158.       if ((BCK(CCLM) /= NIL) or (OLDEC /= BCK(CCLM))) then 
  159.         BCK(CCLM) := NIL; 
  160.         FWD(OLDEC) := NIL; 
  161.       end if; 
  162.  
  163.       FWD(NEWEC) := NIL; 
  164.  
  165.       -- find next ccl member to process
  166.       CCLP := CCLP + 1; 
  167.  
  168.       while ((CCLP < LENCCL + CCLS'FIRST) and PROC_ARRAY(CCLP)) loop
  169.  
  170.         -- reset "doesn't need processing" flag
  171.         PROC_ARRAY(CCLP) := FALSE; 
  172.         CCLP := CCLP + 1; 
  173.       end loop; 
  174.     end loop; 
  175.   exception
  176.     when STORAGE_ERROR => 
  177.       MISC.AFLEXFATAL("dynamic memory failure in mkeccl()"); 
  178.   end MKECCL; 
  179.  
  180.  
  181.   -- mkechar - create equivalence class for single character
  182.  
  183.   procedure MKECHAR(TCH      : in INTEGER; 
  184.                     FWD, BCK : in out C_SIZE_ARRAY) is 
  185.   begin
  186.  
  187.     -- if until now the character has been a proper subset of
  188.     -- an equivalence class, break it away to create a new ec
  189.     if (FWD(TCH) /= NIL) then 
  190.       BCK(FWD(TCH)) := BCK(TCH); 
  191.     end if; 
  192.  
  193.     if (BCK(TCH) /= NIL) then 
  194.       FWD(BCK(TCH)) := FWD(TCH); 
  195.     end if; 
  196.  
  197.     FWD(TCH) := NIL; 
  198.     BCK(TCH) := NIL; 
  199.   end MKECHAR; 
  200.  
  201. end ECS; 
  202.